home *** CD-ROM | disk | FTP | other *** search
/ CD Actual 9 / CDACTUAL9.iso / share / Dos / VARIOS / pascal / SWAG9605.DDD / 0110_T.V. Progress Bar.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1996-05-31  |  4.8 KB  |  151 lines
  1. {
  2.  Since I received the request I post the following Turbo Vision snippet. The
  3.  object in the code below is a very basic growbar. It is meant to be inserted
  4.  into a dialog box and to show the progress of a certain action. The object
  5.  is very simple so I didn't comment the source. I did include an example on
  6.  how to put the progress bar into a dialog box. If you have questions about
  7.  this code, feel free to ask. This is the text version of this object, the
  8.  graphical version will follow later (it is a bit more complicated and I want
  9.  to comment on it).
  10.  
  11.  Here we go :
  12.  
  13.  {==========================================================================}
  14.  {= Unit name      : GrowView                                              =}
  15.  {= Version        : 1.0                                                   =}
  16.  {= Public Objects : TGrowView                                             =}
  17.  {===--------------------------------------------------------------------===}
  18.  {= Programmer     : David van Driessche                                   =}
  19.  {= Language       : Borland Pascal 7.0                                    =}
  20.  {===--------------------------------------------------------------------===}
  21.  {= This code is property of David van Driessche (FidoNet 2:291/1933.13)   =}
  22.  {= Please use it as you like.                                             =}
  23.  {==========================================================================}
  24.  
  25.  {$F+,O+,X+,I+,B-,V-}
  26.  
  27.  {$ifdef DebugVersion}
  28.   {$R+,S+,Q+,D+,L+,Y+}
  29.  {$else}
  30.   {$R-,S-,Q-,D-,L-,Y-}
  31.  {$endif}
  32.  
  33.  unit GrowView ;
  34.  
  35.  interface
  36.  
  37.  uses Objects, Views ;
  38.  
  39.  type
  40.   PGrowView = ^TGrowView ;
  41.   TGrowView = object( TView )
  42.                constructor Init( var R : TRect ; ATotal : Longint ) ;
  43.                procedure   Draw ; virtual ;
  44.                function    GetPalette : PPalette ; virtual ;
  45.                procedure   Update( NewValue : Longint ) ;
  46.                private
  47.                Total       : Longint ;
  48.                Value       : Longint ;
  49.                NumBlock    : Integer ;
  50.                function    CalcBlock : Integer ;
  51.               end ;
  52.  
  53.  {
  54.   Feel free to dissagree with my choice of colors. This palette maps into the
  55.   TDialog palette and produces a black 'background' bar with yellow blocks.
  56.  }
  57.  const
  58.   CGrowView = #6#9 ;
  59.  
  60.  implementation
  61.  
  62.  uses Drivers ;
  63.  
  64.  constructor TGrowView.Init( var R : TRect ; ATotal : Longint ) ;
  65.   begin
  66.    inherited Init( R ) ;
  67.    Total        := ATotal ;  { Remember the 100% value }
  68.    Value        := 0 ;       { Current value is 0 }
  69.    NumBlock     := 0 ;       { No colored blocks so far }
  70.   end ;
  71.  
  72.  { Calculate the number of colored blocks for the current 'Value' }
  73.  function TGrowView.CalcBlock : Integer ;
  74.   begin
  75.    CalcBlock := Round( Size.X / Total * Value ) ;
  76.   end ;
  77.  
  78.  procedure TGrowView.Draw ;
  79.   var
  80.    R      : TRect ;
  81.    B      : TDrawBuffer ;
  82.   begin
  83.    MoveChar( B, '▒', GetColor( 1 ), Size.X ) ;
  84.    MoveChar( B, #0 , GetColor( 2 ), NumBlock ) ;
  85.    WriteLine( 0, 0, Size.X, Size.Y, B ) ;
  86.   end ;
  87.  
  88.  function TGrowView.GetPalette: PPalette ;
  89.   const
  90.    P : string[ Length(CGrowView) ] = CGrowView ;
  91.   begin
  92.    GetPalette := @P ;
  93.   end ;
  94.  
  95.  {
  96.   This object was originally written in my graphical Turbo Vision variant. In
  97.   this graphical world, drawing is very expensive (in terms of execution time)
  98.   compared to calculating. I therefor try to avoid to redraw the progress bar
  99.   if it is not necessary. The optimisations in the graphical variant are
  100.   more complicated then what I left in here.
  101.  }
  102.  procedure TGrowView.Update( NewValue : Longint ) ;
  103.   var
  104.    NewBlock : integer ;
  105.   begin
  106.    { An update request : did my situation change ? }
  107.    if (Value <> NewValue) then
  108.     begin
  109.      { Yes it did, remember the new situation }
  110.      Value    := NewValue ;
  111.      { Calculate the new number of colored blocks }
  112.      NewBlock := CalcBlock ;
  113.      { If this number didn't change we don't need to redraw }
  114.      if (NewBlock <> NumBlock) then
  115.       begin
  116.        { Pitty, we do need the redraw. }
  117.        NumBlock := NewBlock ;
  118.        Draw ;
  119.       end ;
  120.     end ;
  121.   end ;
  122.  
  123.  end.
  124.  
  125.  ---------- End of unit -----------------------------------------------------
  126.  
  127.  As I said this is a very simple object (though nice). Here is an example on
  128.  how to get it into a dialog box (a quite stupid example too).
  129.  
  130.  procedure TMsgApplication.About ;
  131.   var
  132.    R       : TRect ;
  133.    Counter : Integer ;
  134.    GV      : PGrowView ;
  135.    D       : PDialog ;
  136.   begin
  137.    R.Assign( 0, 0, 40, 5 ) ;
  138.    D := New( PDialog, Init( R, 'Test' )) ;
  139.    R.Assign( 2, 2, 38, 3 ) ;
  140.    GV := New( PGrowView, Init( R, 100 )) ;
  141.    D^.Insert( GV ) ;
  142.    DeskTop^.Insert( D ) ;
  143.    for Counter := 1 to 100 do
  144.     begin
  145.      Delay( 100 ) ;
  146.      GV^.Update( Counter ) ;
  147.     end ;
  148.    Dispose( D, Done ) ;
  149.   end ;
  150.  
  151.